COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C DUPINS.F4  TO DUPLICATE INSTRUMENTS IN FILES
C00009 ENDMK
C⊗;
C DUPINS.F4  TO DUPLICATE INSTRUMENTS IN FILES
C ****** LOAD WITH FORNAM.FAI (INCLUDES RENAM.FAI) *********
	DIMENSION I(72),J(200,72),LINC(5)
	COMMON NM,LNUM
 	DATA LINC/536870912,4194304,32768,256,2/
	IFOUND=0
	IEXT=' '
	OEXT=' '
	TYPE 1
1	FORMAT(' **** MAKES DUPLICATES OF INSTRUMENTS ****'/
	1' ALL FILE NAMES AND INSTRUMENT NAMES CAN HAVE NO MORE THAN 
	15 LETTERS'//' TYPE INPUT FILE NAME   '$)
2	FORMAT(2A5,A1,2A5)
202	FORMAT(1X2A5,A1,2A5)
	ACCEPT 8,I
CCC	ACCEPT 2,INAME
	CALL NAMEXT(I,NAME,IEXT)
CIRC70	CALL FORNAM(NAME,IEXT)
	CALL JFILE(1,NAME,IEXT)
CIRC	CALL IFILE(1,INAME)
3	FORMAT(' OUTPUT FILE NAME   '$)
	TYPE 3
	ACCEPT 8,I
	CALL NAMEXT(I,ONAME,OEXT)
	CALL OFILE(21,ONAME,OEXT)
4	FORMAT(' INST. TO BE DUPLICATED --'$)
5	TYPE 4
	ACCEPT 2,NM
	IF(NM.EQ.' ')GO TO 5
	REREAD 8,I
	TYPE 40
	ACCEPT 41,K
	NUM=K+1
	DO 44 K=1,72
44	IF(I(K).EQ.' ')GO TO 45
45	LNUM=K-1
C***********	GO TO 5
C LNUM IS NUMB OF LETTERS IN INST NAME.
40	FORMAT(' HOW MANY DUPLS?   '$)
41	FORMAT(I)
CIRC42	CALL OFILE(21,'$')
	IDIR=0
	IJ=1
6	READ(1,2,END=100),K
	REREAD 8,I
CIRC	IF(I(3).NE.';')GO TO 43
CIRC	IDIR=0
C THIS STUFF TO AVOID DIRECTORY
CIRC	GO TO 6
CIRC43	IF(K.EQ.'COMME')IDIR=-1
CIRC	IF(IDIR)GO TO 6
	CALL SHORT(I,L)
	IF(K.EQ.'INSTR')GO TO 7
8	FORMAT(72A1)
88	FORMAT(1X72A1)
9	WRITE(21,8)(I(N),N=1,L)
	GO TO 6
7	IF(NOTNAM(N).EQ.0)GO TO 105
	TYPE 88,(I(N),N=1,L)
	GO TO 9
C NEXT FOUND NAME TO DUPLICATE
105	INC=LINC(LNUM)
	REREAD 2,KK,LL,MM,NM,NNN
	NJ=0
	GO TO 10
103	PAUSE 'NO "END;" FOUND'
12	READ(1,8,END=103)I
10	NJ=NJ+1
	DO 11 K=1,72
11	J(NJ,K)=I(K)
C PUT A LINE INTO J ARRAY
	IF(I(1).NE.'E')GO TO 12
	IF(I(2).NE.'N')GO TO 12
	IF(I(3).NE.'D')GO TO 12
C USE 5-LETTER NAMES!!!
	IFOUND=-1
	NZ=0
104	JK=0
	NZ=NZ+1
13	JK=JK+1
	DO 14 K=1,72
14	I(K)=J(JK,K)
	IF(JK.NE.1)GO TO 50
	WRITE(21,2)KK,LL,MM,NM,NNN
	TYPE 202,KK,LL,MM,NM,NNN
C THIS LINE HAS INST. NAME.
	NM=NM+INC
	GO TO 15
50	CALL SHORT(I,K)
	WRITE(21,8)(I(N),N=1,K)
CC	TYPE 88,(I(N),N=1,K)
15	IF(JK.LT.NJ)GO TO 13
	IF(NZ.LT.NUM)GO TO 104
	GO TO 6
100	IF(IFOUND)GO TO 1001
	TYPE 1000,NM
	CALL EXIT
1000	FORMAT(' ***** INSTRUMENT ',A5,' NOT FOUND *****')
1001	TYPE 101,ONAME,OEXT
101	FORMAT(/' DUPLICATE INSTS ON FILE -- ',A5,A4)
CIRC	END FILE 21
CIRC	REWIND 21
CIRC	CALL RENAM('$','DAT',ONAME,OEXT)
	END

	SUBROUTINE SHORT(I,K)
	DIMENSION I(1)
	DO 1 K=72,1,-1
1	IF(I(K).NE.' ')RETURN
	END

	FUNCTION NOTNAM(N)
	COMMON NM,LNUM
	DIMENSION FM(3),A(5)
	DATA A/'A1)','A2)','A3)','A4)','A5)'/
	1 ,FM/'(2A5,','A1,',0/
	FM(3)=A(LNUM)
	NOTNAM=0
	REREAD FM,K,K,K,K
1	IF(K.NE.NM)NOTNAM=-1
	END

	SUBROUTINE NAMEXT(I,NAME,IEXT)
	EQUIVALENCE (A5,A(5)),(FM2,FM(2)),(FM3,FM(3)),(FM4,FM(4)),
	1 (FM5,FM(5)),(A3,A(3)),(A4,A(4))
	DIMENSION  A(5),FM(5),I(1)
	DATA A/'A1','A2','A3','A4','A5'/,FM(1)/'('/
	DO 69 K=2,5
69	FM(K)=' '
	ID=0
	IA=0
	NAME=' '
	DO 61 K=20,1,-1
	IF(I(K).EQ.' ')GO TO 61
65	DO 62 L=K-1,1,-1
	N=I(L)
63	IF(N.NE.'.')GO TO 62
	ID=L
C '.' ASSUMES THERE IS AN EXTENSION 
	GO TO 64
62	CONTINUE
	GO TO 64
61	CONTINUE
C ALL BLANK IF WE GET HERE
64	IF(ID.NE.0)GO TO 67
C NOW ONLY A NAME IS ON THIS LINE
	FM2=A5
	FM3=')'
	REREAD FM,NAME
	GO TO 70
CIRC67	FM3=',A1,'
67	FM2=A(ID-1)
	FM3=','
	FM4=A4
	FM5=')'
C  FOUND NAME AND EXTENSION
68	REREAD FM, NAME,IEXT
70	END
C THIS ROUTINE ALLOWS NAMES OF FROM 1 TO 5 LETTERS TO BE USED.
C NO EXTENSIONS CAN BE USED.  IFI RETURNS INFO RE. LINE NUMS.
C READS SOS, ET AND OTHER FILES WITHOUT LINE NUMS.
	SUBROUTINE IFILE(I,N)
	EQUIVALENCE (NN,NAME),(NN2,NN(2)),(NN3,NN(3))
	COMMON /NN/NN(3) /IFI/IFI
	DOUBLE PRECISION NAME
	DATA NN2/'.'/
	NN(1)=N
	OPEN(UNIT=I,FILE=NAME)
	IF(NN3)GO TO 6
	IF(NN2.NE.'.')GO TO 1
C JUMP IF COMING FROM OFILE CALL
6	READ(I,2)K,J
	IFI=-1
	IF(K.NE.'00')GO TO 3
	IFI=0 
C IFI = 0 = LINE NUMBERS.
5	OPEN(UNIT=I,FILE=NAME)
C REOPEN IF LINE NUMS.
	GO TO 1
3	IF(K.NE.'CO')GO TO 5
	IF(J.NE.'MMENT')GO TO 5
4	READ(I,2)K,J
C READS COMMENTS ON DIRECTORY PAGE.
	IF(J.NE.';')GO TO 4
2	FORMAT(A2,A5)
1	NN2='.'
	NN3=0
	END
	SUBROUTINE OFILE(I,N,IEXT)
	COMMON /NN/NN(3)
	IF(IEXT.EQ.' ')IEXT=' .'
	NN(2)=IEXT
	NN(3)=0
	CALL IFILE(I,N)
	END
	SUBROUTINE JFILE(I,N,IEXT)
	COMMON /NN/NN(3)
C USE THIS TO PRECEDE IFILE FOR INPUT FILE NAME
	IF(IEXT.EQ.' ')IEXT=' .'
	NN(2)=IEXT
	NN(3)=-1
	CALL IFILE(I,N)
	END